Computer Shopper 233/Computer Shopper 233/ComputerShopperDVD233.iso/mpf/eng/shared/agentdui.cab/scui.dll/HTML/MPS.VBS

Text File | 2005-07-27 | 19.0 KB | 800 lines

'/////////////////////////////////////////////////////////////////////////////////////////////////////////
'Standard defines from MSCIFCONSTS.H

Const USER_TYPE_NONE      = 0
Const USER_TYPE_ADMIN     = 1
Const USER_TYPE_USER      = 2


'/////////////////////////////////////////////////////////////////////////////////////////////////////////
'Function return values

Const CFGUSER_GENERIC_ERROR                     = -1
Const CFGUSER_SUCCESS                           = 0
Const CFGUSER_ERROR                             = 1
Const CFGUSER_USER_ALREADY_PRESENT              = 2
Const CFGUSER_PASSWORD_CHANGE_FAILED            = 3
Const CFGUSER_LOGIN_FAILED                      = 4
Const CFGUSER_NOUSER_LOGGED_IN                  = 5
Const CFGUSER_WRONG_PASSWORD                    = 6
Const CFGUSER_ANOTHER_USER_LOGGEDIN             = 7
Const CFGUSER_GLOBALMUTEX_ERROR                 = 8
Const CFGUSER_USER_LOGGEDIN_ANOTHER_SESSION     = 9
Const CFGUSER_USER_INVALID_USER                 = 10
Const CFGUSER_NO_DEFUSER                        = 11


'/////////////////////////////////////////////////////////////////////////////////////////////////////////
'Command IDs (Update Boundry check variables if adding / deleting

Const ID_MSCIF_EXIT                   = 40001
Const ID_USER_LOGIN                   = 40002
Const ID_USER_LOGOUT                  = 40003
Const ID_USER_CONFIGURATION           = 40004
Const ID_MSCIF_SHUTDOWN               = 40005
Const ID_MSCIF_DISABLE                = 40007
Const ID_MSCIF_ENABLE                 = 40008
Const ID_MSCIF_HELP                   = 40009
Const ID_USER_LOGIN_ANDOR_CONFIG      = 40010
Const ID_MSCIF_USERS                  = 40011
Const ID_MSCIF_EVENTLOG               = 40012
Const ID_MSCIF_ABOUT                  = 40013
Const ID_MSCIF_CHECKEXPIRY              = 40014

' Boundry condition check variables.
' NOTE: Update these values if adding an ID above
Const ID_MSCIF_BEGIN_IDS              = 40001
Const ID_MSCIF_END_IDS                    = 40014


'/////////////////////////////////////////////////////////////////////////////////////////////////////////
'General constants

Const MPS_CLSID                          = "{13DB6EFF-AF1B-483e-8F7B-F1978AD6D4E1}"
Const MPS_APP_NAME                      = "MscIfApp.exe"
Const MPS_CMDARG_VERIFY_STR              = "/Verify"

Const MPS6_CLSID                      = "{983DD781-10DA-4C25-8706-9E152DFCEF90}"
Const MPS6_APPNAME                    = "guarddog.exe"
Const MPS6_REGVAL_INSTALL_LOC         = "InstallLocation"
Const MPS6_REG_KEY                    = "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
Const MPS6_MIN_VER                      = "6,0,0,0"

'/////////////////////////////////////////////////////////////////////////////////////////////////////////
'Error strings

Const ERR_SUCCEEDED                      = "Success."
Const ERR_NO_MCINSTALL                  = "Failed to load the MCINSCTL App Helper Object."
Const ERR_NO_MPSDISPATCH              = "Failed to acquire the MPS default Dispatch Interface."
Const ERR_NO_REGOBJ                   = "Failed to get the registry object from MCINSCTL."

Const ERR_GETACTIONITEM_GENERIC_FAIL  = "Failed to get the list of Command IDs."
Const ERR_INVOKECOMMAND_INVALID_CMD   = "Invalid command ID."
Const ERR_INVOKECOMMAND_GENERIC_FAIL  = "Failed to invoke the command."

'Following Consts are required to check if perpetual product is installed...
Const REG_MPS_KEY                 = "HKLM\Software\McAfee.com\Privacy Service"
Const REG_MPS_PRODUCTTYPE_NAME        = "ProductType"     '// Product information
Const MPS_PRODUCT_INSTALL_TYPE_NODIE_NOUPDATES  = &H00000200

'/////////////////////////////////////////////////////////////////////////////////////////////////////////
'End Constants

Dim gobjMPSDisp, gmcAppHelper


Function TestIt()
'{

    Dim szError, itemArr
    Dim eResult

    eResult = MPS_OnLoad()
    If False = eResult Then
        MsgBox "MPS_OnLoad() failed..."
        Exit Function
    End if

    eResult = MPS_GetActionItem(itemArr, szError)
    If eResult <> CFGUSER_SUCCESS Then
        MsgBox szError
        Exit Function
    End If

    If IsArray(itemArr) Then

        for nIdx = LBound(itemArr) To UBound(itemArr)
           MsgBox "Index = " & nIdx & " : " & "Value = " & itemArr(nIdx)
        Next

    End if

    eResult = gobjMPSDisp.InvokeCommand(40004)
    Call MPS_OnUnLoad()

'}
End Function

' Call TestIt()


Function GetObjectPath( sCLSID, objOS, objFS )
'{
    Dim   sPath

    GetObjectPath = ""
    sPath = objOS.GetObjectModuleDir( sCLSID )
    If "" = sPath Then
    '{
        Exit Function
    '}
    End If

    GetObjectPath = objFS.GetShortPathName( sPath )
'}
End Function

'0 == Application started
'1 == Application could not be started
Function LaunchProgram( szPath, szCmdLine, eResult )
'{
    eResult = 1

    If False = IsObject( g_localObjOS ) Then
        LaunchProgram = eResult
        Exit Function
    End If

    If False = IsObject( g_localObjFS ) Then
        LaunchProgram = eResult
        Exit Function
    End If

    If g_localObjOS is nothing Or _
        g_localObjFS is nothing Then
    '{
        LaunchProgram = eResult
        Exit Function
    '}
    End If

    If "" <> szPath And "" <> szCmdLine Then
    '{
        If 0 = g_localObjOS.RunProgram( szPath, CStr(szCmdLine) ) Then
            eResult = 1
        Else
            eResult = 0
        End If
    '}
    End If
    LaunchProgram = eResult
'}
End Function

' MPS_OnLoad() returns FALSE on a failure.
' It returns TRUE on a success.

Function MPS_OnLoad(ByRef szError)
'{

    Set gobjMPSDisp = nothing

    Set gmcAppHelper = g_localObjExternal.CreateObject(CLSID_CoMCAppHelper, CLSID_LIC, true )
    If gmcAppHelper is nothing Then
        szError = ERR_NO_MCINSTALL
        MPS_OnLoad = False
        Exit Function
    End If

    szError = ERR_SUCCEEDED
    MPS_OnLoad = True

'}
End Function

Function MPS_OnUnload()
'{
    Set gmcAppHelper = nothing
    Set gobjMPSDisp = nothing
'}
End Function

Function MPSDisp_OnUnload()
'{
    Set gobjMPSDisp = nothing
'}
End Function

Function MPS_ValidateObjects(ByRef szError)
'{

    If gmcAppHelper is nothing Then
    '{

        szError = ERR_NO_MCINSTALL
        MPS_ValidateObjects = CFGUSER_ERROR

        Exit Function

    '}
    End If

    If gobjMPSDisp is nothing Then
    '{

        Set gobjMPSDisp = gmcAppHelper.GetObject( MPS_CLSID )

        If gobjMPSDisp is nothing Then
            szError = ERR_NO_MPSDISPATCH
            MPS_ValidateObjects = False
            Exit Function
        End If

    '}
    End If

    MPS_ValidateObjects = CFGUSER_SUCCESS
    szError = ERR_SUCCEEDED

'}
End Function

' MPS_GetActionItem() returns CFGUSER_ERROR on a failure and CFGUSER_SUCCESS on success.
' szError contains a description of the error. On success it will say "Success". Typically
' szError should be used only if an error was returned.

' On return, "itemArr" will contain the list of Command IDs returned by MPS dispatch interface.

Function MPS_GetActionItem(ByRef itemArr, ByRef szError)
'{

    Dim eResult

    eResult = MPS_ValidateObjects(szError)
    If CFGUSER_SUCCESS <> eResult Then
        MPS_GetActionItem = eResult
        Exit Function
    End if

    szError = ""

    eResult = gobjMPSDisp.GetActionItem(itemArr)
    If eResult = CFGUSER_SUCCESS Then
        szError = ERR_SUCCEEDED
    Else
        szError = ERR_GETACTIONITEM_GENERIC_FAIL
    End If

    MPS_GetActionItem = eResult

'}
End Function


' MPS_InvokeCommand() returns CFGUSER_ERROR on a failure and CFGUSER_SUCCESS on success.
' szError contains a description of the error. On success it will say "Success". Typically
' szError should be used only if an error was returned.

' lCommandID is the command ID to be invoked.

Function MPS_InvokeCommand(lCommandID, ByRef szError)
'{

    Dim eResult

    eResult = MPS_ValidateObjects(szError)
    If CFGUSER_SUCCESS <> eResult Then
        MPS_InvokeCommand = eResult
        Exit Function
    End if

    szError = ""

    If lCommandID < ID_MSCIF_BEGIN_IDS Or lCommandID > ID_MSCIF_END_IDS Then
        MPS_InvokeCommand = CFGUSER_ERROR
        szError = ERR_INVOKECOMMAND_INVALID_CMD
        Exit Function
    End If

    MPS_InvokeCommand = CFGUSER_ERROR
    On Error Resume Next
    eResult = gobjMPSDisp.InvokeCommand(lCommandID)
    If eResult = CFGUSER_SUCCESS Then
        szError = ERR_SUCCEEDED
    Else
        szError = ERR_INVOKECOMMAND_GENERIC_FAIL
    End If

    MPS_InvokeCommand = eResult

'}
End Function


' MPS_GetUserType() will return ADMIN, USER, or NONE (no user is logged in).
' The function returns USERTYPE_ERROR (-1) on error. szError contains the error
' string and typically it will make sense only when the return value is an error.

Function MPS_GetUserType(ByRef szError)
'{

    MPS_GetUserType = CFGUSER_GENERIC_ERROR
    eResult = MPS_ValidateObjects(szError)
    If CFGUSER_SUCCESS <> eResult Then
        Exit Function
    End if

    szError = ERR_SUCCEEDED
    On Error Resume Next
    MPS_GetUserType = gObjMPSDisp.get_LoginUserType()

'}
End Function

' True = Enabled, False = Disabled.
' szError returns a string description of the error. Typically should be used
' only if an error was returned.

' The only error return value from this function is -1, or CFGUSER_GENERIC_ERROR

Function MPS_IsEnabled(ByRef szError)
'{

    Dim bOldOfuscate, dwState

    szError = ERR_SUCCEEDED

    If g_localObjReg Is Nothing Then
        MPS_IsEnabled = 1
        szError = ERR_NO_REGOBJ
        Exit Function
    End If

    bOldOfuscate = g_localObjReg.obfuscate

    g_localObjReg.obfuscate = True

    dwState = g_localObjReg.RegQueryValue( CStr("HKLM\Software\McAfee.com\Agent\Apps\MPS"), CStr("State") )
    If 0 = dwState Then
        MPS_IsEnabled = 0
    Else
        MPS_IsEnabled = 1
    End If

    g_localObjReg.obfuscate = bOldOfuscate

'}
End Function


' /////////////////////////////////////////////////////////////////////////////
' Application interface with dashboard
' /////////////////////////////////////////////////////////////////////////////

Function IsMPSEnabled()
'{
    Dim szErr
    Dim nIsEnabled

    IsMPSEnabled = 0

    nIsEnabled = MPS_IsEnabled( szErr )
    IsMPSEnabled = nIsEnabled
'}
End Function

Function OnEnableMPS()
'{
    Dim szErr
    Dim dwCommandId
    dwCommandId = ID_MSCIF_ENABLE
    call MPS_InvokeCommand( dwCommandId, szErr )

    'Now we have a Timer that calls GetNewMPSState every 1500 msec
    'which in turn calls these functions, so we don't need to call it here...
    'SetDocumentTitleString()
'}
End Function

Function OnDisableMPS()
'{
    Dim szErr
    Dim dwCommandId
    dwCommandId = ID_MSCIF_DISABLE
    call MPS_InvokeCommand( dwCommandId, szErr )

    'Now we have a Timer that calls GetNewMPSState every 1500 msec
    'which in turn calls these functions, so we don't need to call it here...
    'SetDocumentTitleString()
'}
End Function

Function OnVerifyMPS()
'{
    Dim szErr
    Dim dwCommandId
    dwCommandId = ID_MSCIF_CHECKEXPIRY

    If False = IsObject( g_localObjOS ) Or g_localObjOS is nothing Then
        Exit Function
    End If

    If False = IsObject( g_localObjFS ) Or g_localObjFS is nothing Then
        Exit Function
    End If

    Call MPSDisp_OnUnload()

    Dim eResult
    Dim szPath
    szPath = GetObjectPath( MPS_CLSID, g_localObjOS, g_localObjFS )
    szPath = CStr(szPath & "\" & MPS_APP_NAME)
    LaunchProgram szPath, MPS_CMDARG_VERIFY_STR, eResult
'}

End Function

Function SignIn()
'{
    Dim szErr
    Dim dwCommandId
    dwCommandId = ID_USER_LOGIN
    call MPS_InvokeCommand( dwCommandId, szErr )

    'Now we have a Timer that calls GetNewMPSState every 1500 msec
    'which in turn calls these functions, so we don't need to call it here...
    'Dim userType
    'userType = MPS_GetUserType( szErr )

    'SetSignedInState( userType )
'}
End Function

Function SignOut()
'{
    Dim szErr
    Dim dwCommandId
    dwCommandId = ID_USER_LOGOUT
    call MPS_InvokeCommand( dwCommandId, szErr )

    'Now we have a Timer that calls GetNewMPSState every 1500 msec
    'which in turn calls these functions, so we don't need to call it here...
    'Dim userType
    'userType = MPS_GetUserType( szErr )

    'SetSignedInState( userType )

'}
End Function

Function ViewEventLog()
'{
    Dim szErr
    Dim dwCommandId
    dwCommandId = ID_MSCIF_EVENTLOG
    call MPS_InvokeCommand( dwCommandId, szErr )
'}
End Function

Function ConfigureUser()
'{
    Dim szErr
    Dim dwCommandId
    dwCommandId = ID_MSCIF_USERS
    call MPS_InvokeCommand( dwCommandId, szErr )
'}
End Function

Function ShowOptions()
'{
    Dim szErr
    Dim dwCommandId
    dwCommandId = ID_USER_CONFIGURATION
    call MPS_InvokeCommand( dwCommandId, szErr )
'}
End Function

Function ShowAbout()
'{
    Dim szErr
    Dim dwCommandId
    dwCommandId = ID_MSCIF_ABOUT
    call MPS_InvokeCommand( dwCommandId, szErr )
'}
End Function


'//
'// IsMPS4Installed()
'//
'// Return Values:
'// -2: If VSO is not installed.
'// -1: Error code.
'// 0: If Old VSO (3.X) is installed.
'// 1: If VSO 4 is installed.
Function IsMPS4Installed( objReg, objOS, objFS )
'{
  Dim eResult

Const MPS_CLSID                          = "{13DB6EFF-AF1B-483e-8F7B-F1978AD6D4E1}"

  IsMPS4Installed = -1
  If False = IsObject( objOS ) Then
    Exit Function
  End If

  If objOS is nothing Then
    Exit Function
  End If

  IsMPS4Installed = -2
  eResult = objOS.IsObjectInstalled( MPS_CLSID, "4,0,0,0" )

  Select Case eResult
  '{
    Case 0 '// MCINST_OS_NO_VERSION_INFO
      Exit Function
    Case 1 '// MCINST_OS_OLDER_VERSION_EXISTS
      IsMPS4Installed = 0
    Case 2 '// MCINST_OS_OBJECT_EXISTS
      IsMPS4Installed = 1
    Case 3 '// MCINST_OS_OBJECT_NOT_FOUND
      IsMPS4Installed = -2
  '}
  End Select
'}
End Function


'//
'// IsMPS6Installed()
'//
'// Return Values:
'// -2: If MPS6 is not installed.
'// -1: Error code.
'// 1: If MPS 6 and above is installed.
Function IsMPS6Installed(objReg, objOS, objFS)
'{

    Dim szPath, eResult
    szPath = objReg.RegQueryValue(MPS6_REG_KEY & "\" & MPS6_CLSID, MPS6_REGVAL_INSTALL_LOC)

    If ( Len(szPath) > 0) Then
        szPath = CStr(szPath) & MPS6_APPNAME
    Else
        IsMPS6Installed = -2
        Exit Function
    End If

    eResult = objOS.CheckVersion(szPath, MPS6_MIN_VER)

    ' I am not returning an error code. If 6,0,0,0 and above is not present then MPS is not
    ' installed...

    ' MCINST_OS_OBJECT_EXISTS = 2

    If (2 = eResult) Then
      IsMPS6Installed = 1
    Else
      IsMPS6Installed = -2
    End If

'}
End Function

'//
'// IsMPSInstalled()
'//
'// Return Values:
'// -2: If MPS is not installed.
'// -1: Error code.
'// 0: If Old MPS (3.X or MPS 4.x) is installed.
'// 1: If MPS 6 and above is installed.
Function IsMPSInstalled(objReg, objOS, objFS)
'{

    Dim nResult
    nResult = IsMPS6Installed(objReg, objOS, objFS)

    If -2 = nResult Then
    '{
        nResult = IsMPS4Installed(objReg, objOS, objFS)
    '}
    End If

   IsMPSInstalled = nResult

'}
End Function


'1 = Expired, 0 = Not Expired
Function IsMPSExpired()
'{
    Dim    szExpDate

    If g_localObjInstaller is nothing Or Not IsObject( g_localObjInstaller ) Then
        IsMPSExpired = 1
        Exit Function
    End If

    If False = WillMPSProductExpire() Then
        IsMPSExpired = 0
        Exit Function
    End If

    szExpDate = ""
    g_localObjInstaller.GetExpiryDate "HKLM\Software\McAfee.com\Privacy Service", "Settings", szExpDate

    If Len(szExpDate) <> 8 Then
        IsMPSExpired = 1
        Exit Function
    End If

    Dim szExpYear, szExpMonth, szExpDay
    szExpYear = Left( szExpDate, 4 )
    szExpMonth = Mid( szExpDate, 5, 2 )
    szExpDay = Mid( szExpDate, 7, 2)

    Dim glExpYear, glExpMonth, glExpDay

    glExpYear  = CStr( szExpYear )
    glExpMonth = CStr( szExpMonth )
    glExpDay   = CStr( szExpDay )

    Dim actualExpiryDate
    actualExpiryDate = DateSerial( glExpYear, glExpMonth, glExpDay )

    If False = IsDate( actualExpiryDate ) Then
    '{
        'Tampered Expiry setting
        IsMPSExpired = 1
        Exit Function
    '}
    End If

    If DateDiff( "d", Date, actualExpiryDate ) >= 0 Then
        IsMPSExpired = 0
    Else
        IsMPSExpired = 1
    End If

'}
End Function

Function WillMPSProductExpire()
'{
  Dim sTemp

  WillMPSProductExpire = True

  If IsObject(gobjReg) Then
  '{
    If not gobjReg is nothing Then
    '{
      gobjReg.Obfuscate = True

        sTemp = Trim(gobjReg.RegQueryValue(REG_MPS_KEY, REG_MPS_PRODUCTTYPE_NAME))
        If IsNumeric(sTemp) And Len(sTemp) > 0 Then
          If (CLng(sTemp) And MPS_PRODUCT_INSTALL_TYPE_NODIE_NOUPDATES) <> 0 Then
            WillMPSProductExpire = False
          End If
        End If

      gobjReg.Obfuscate = False
    '}
    End If
  '}
  End If
'}
End Function

'--------------------------------------------------------------------------------
' To Support Retail products in Dashboard, we need to have a set of function
' that check for Retail product state (Expired/Enabled/Disabled) etc

'1 = Installed, 0 = Not Installed, -1 = Error
Function IsRetailMPSInstalled()
'{
    Dim bOldOfuscate, bRetail
    If g_localObjReg Is Nothing Then
        IsRetailMPSInstalled = -1
        Exit Function
    End If

    bRetail = 0
    bOldOfuscate = g_localObjReg.obfuscate
    g_localObjReg.obfuscate = True
    bRetail = g_localObjReg.RegQueryValue( CStr("HKLM\Software\McAfee.com\Agent\Apps\MPS"), CStr("Retail") )
    If 1 = bRetail Then
        IsRetailMPSInstalled = 1
    Else
        IsRetailMPSInstalled = 0
    End If
    g_localObjReg.obfuscate = bOldOfuscate
'}
End Function

'1 = Expired, 0 = Not Expired
Function IsRetailMPSExpired()
'{
    Dim    szExpDate

    If g_localObjInstaller is nothing Or Not IsObject( g_localObjInstaller ) Then
        IsRetailMPSExpired = 1
        Exit Function
    End If

    ' If Product type says its perpetual product return not expired...
    If False = WillMPSProductExpire() Then
        IsRetailMPSExpired = 0
        Exit Function
    End If

    szExpDate = ""
    g_localObjInstaller.GetExpiryDate "HKLM\Software\McAfee.com\Privacy Service", "Settings", szExpDate

    If Len(szExpDate) <> 8 Then
        IsRetailMPSExpired = 1
        Exit Function
    End If

    Dim szExpYear, szExpMonth, szExpDay
    szExpYear = Left( szExpDate, 4 )
    szExpMonth = Mid( szExpDate, 5, 2 )
    szExpDay = Mid( szExpDate, 7, 2)

    Dim glExpYear, glExpMonth, glExpDay

    glExpYear  = CStr( szExpYear )
    glExpMonth = CStr( szExpMonth )
    glExpDay   = CStr( szExpDay )

    Dim actualExpiryDate
    actualExpiryDate = DateSerial( glExpYear, glExpMonth, glExpDay )

    If False = IsDate( actualExpiryDate ) Then
    '{
        'Tampered Expiry setting
        IsRetailMPSExpired = 1
        Exit Function
    '}
    End If

    If DateDiff( "d", Date, actualExpiryDate ) >= 0 Then
        IsRetailMPSExpired = 0
    Else
        IsRetailMPSExpired = 1
    End If

'}
End Function

'//
'// IsRetailMPSEnabled(): Return Values.
'//
'// -1: Error Code
'// 0: Application is not running
'// 1: Application is running.
Function IsRetailMPSEnabled()
'{
    Dim bOldOfuscate, dwState
    If g_localObjReg Is Nothing Then
        IsRetailMPSEnabled = -1
        Exit Function
    End If

    dwState = 0
    bOldOfuscate = g_localObjReg.obfuscate
    g_localObjReg.obfuscate = True
    dwState = g_localObjReg.RegQueryValue( CStr("HKLM\Software\McAfee.com\Agent\Apps\MPS"), CStr("State") )
    If 1 = dwState Then
        IsRetailMPSEnabled = 1
    Else
        IsRetailMPSEnabled = 0
    End If
    g_localObjReg.obfuscate = bOldOfuscate
'}
End Function

'--------------------------------------------------------------------------------